home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
regist2a
/
auxcode.bas
next >
Wrap
BASIC Source File
|
1998-03-20
|
3KB
|
116 lines
Attribute VB_Name = "Aux"
Option Explicit
Public g_strFiles() As String
Public Sub Center(ByRef frm As Form)
frm.Top = (Screen.Height - frm.Height) / 2
frm.Left = (Screen.Width - frm.Width) / 2
End Sub
Public Sub FindFiles(ByVal blnRecurse As Boolean, _
ByVal strPath As String, ByVal strFilter As String)
On Error GoTo findfiles_Err
Dim intFileCount As Integer
Dim blnStop As Boolean
Dim strFile As String
Dim intResult As Integer
Dim strDirectories() As String
Dim intDirCount As Integer
Dim intDirSearch As Integer
intFileCount = UBound(g_strFiles)
intDirCount = 0
RegAid!sbrStatus.SimpleText = "Searching: " & strPath
ReDim strDirectories(0)
strFile = Dir(strPath & "\" & strFilter)
Do While strFile <> ""
intFileCount = intFileCount + 1
ReDim Preserve g_strFiles(intFileCount)
g_strFiles(intFileCount - 1) = strPath & "\" & UCase$(strFile)
strFile = Dir
Loop
If blnRecurse Then
'Build list of directories
strFile = Dir(strPath & "\*.*", vbDirectory)
Do While (strFile <> "")
If strFile <> "." And strFile <> ".." Then
intResult = GetAttr(strPath & "\" & strFile) And vbDirectory
If intResult <> 0 Then
intDirCount = intDirCount + 1
ReDim Preserve strDirectories(intDirCount)
strDirectories(intDirCount - 1) = strFile
End If
End If
strFile = Dir
Loop
'Recurse through all directories
For intDirSearch = 0 To intDirCount - 1
Call FindFiles(True, strPath & "\" & strDirectories(intDirSearch), strFilter)
Next intDirSearch
'Reset list for recursion unwinding
Erase strDirectories
ReDim strDirectories(0)
intDirCount = 0
End If
Exit Sub
findfiles_Err:
MsgBox CStr(Err.Number) & " -- " & Err.Description, vbCritical, "RegArbiter"
End Sub
Public Sub ListFiles(ByVal lst As ListBox)
Dim intFileCount As Integer
Dim i As Integer
lst.Clear
intFileCount = UBound(g_strFiles)
For i = 0 To intFileCount - 1
lst.AddItem g_strFiles(i)
Next i
If intFileCount = 0 Then
RegAid!sbrStatus.SimpleText = "No files found for selected mask(s)."
Else
RegAid!sbrStatus.SimpleText = "Files found: " & CStr(lst.ListCount)
End If
End Sub
Public Sub PopulateFilter(lst As ListBox)
Dim intFilterCount As Integer
Dim intFilterMax As Integer
'Default the filter
ReDim g_strFilter(2)
g_strFilter(0) = "*.OCX"
g_strFilter(1) = "*.DLL"
intFilterMax = UBound(g_strFilter)
For intFilterCount = 0 To intFilterMax - 1
lst.AddItem g_strFilter(intFilterCount), intFilterCount
lst.ItemData(intFilterCount) = intFilterCount
Next intFilterCount
End Sub